Technotools/Technotools (Chestnut CD-ROM)(1993).ISO/misc_pto/bc7stub/stubscan.bas

BASIC Source File | 1990-03-14 | 6KB | 177 lines

   'STUBSCAN.BAS   03-14-90  T.E.M.  Scan .BAS for stub file conflicts.
   '--------------------------------------------------------------------
    ON ERROR GOTO E.Handler

    False% = 0: True% = -1

    NOFLTIN& = -1  ' Init as true...can be used.
    NOEDIT& = -1
    NOCOM& = -1
    NOLPT& = -1
    SMALLERR& = -1
   '--------------------------------------------------------------------

    COLOR 15, 0: CLS
    PRINT STRING$(50, 196)
    PRINT STRING$(2, 196);
    PRINT " STUBSCAN parses .BAS for stub file conflicts ";
    PRINT STRING$(2, 196)
    PRINT STRING$(50, 196)
   '------------------------------------------------------------------

   DIM PROPELLER$(4)
   PROPELLER$(1) = "|": PROPELLER$(2) = "/"
   PROPELLER$(3) = CHR$(196): PROPELLER$(4) = "\"
   IPROP% = 1: OPROP% = 1  ' Pointer to action propeller characters
  '------------------------------------------------------------------

   IROW% = CSRLIN
   INPUT "Enter  INPUT <.BAS> path\filename:   ", IFILE$
   PRINT STRING$(50, 196)
   IF IFILE$ = "" THEN GOTO PgmExit
   IFILE$ = UCASE$(IFILE$)
   Temp% = INSTR(IFILE$, ".")
   IF Temp% = 0 THEN IFILE$ = IFILE$ + ".BAS"
   '-------------------------------------------------------------------

100  CLOSE 1: OPEN IFILE$ FOR INPUT AS #1
200  CLOSE 2: OPEN "STUBSCAN.RPT" FOR OUTPUT AS #2
201  PRINT #2, " "
     PRINT #2, IFILE$; " BASIC source file as of ";
     PRINT #2, DATE$; " at "; LEFT$(TIME$, 5); " o`clock."
     PRINT #2, " "
     PRINT #2, "Line  --Stub--   Source statement which may conflict..."
     PRINT #2, "----  --------   --------------------------------------"
   '-------------------------------------------------------------------

  WHILE NOT EOF(1)
     IF NOT EOF(1) THEN LINE INPUT #1, R$
     ICOUNT& = ICOUNT& + 1
     R$ = LTRIM$(R$)                             ' Trim leading spaces
     RLEN% = LEN(R$)
       IF RLEN% < 2 THEN GOTO NextRecord
     R$ = UCASE$(R$)                             ' Toupper
     Temp$ = LEFT$(R$, 1)
     IF Temp$ = "'" THEN GOTO NextRecord
     Temp$ = LEFT$(R$, 3)
     IF Temp$ = "REM'" THEN GOTO NextRecord

     IPROP% = IPROP% + 1: IF IPROP% > 4 THEN IPROP% = 1
     LOCATE IROW%, 36: PRINT PROPELLER$(IPROP%);  ' Action propeller

        Temp% = INSTR(R$, "FOR INPUT ")  ' This one is OK
          IF Temp% <> 0 THEN GOTO EndInput
        Temp% = INSTR(R$, "INPUT ")
          IF Temp% = 0 THEN GOTO EndInput
          NOFLTIN& = False%:  Conflict$ = "  NOFLTIN  "
          GOSUB F.WriteReptLine
          NOEDIT& = False%:  Conflict$ = "  NOEDIT   "
          GOSUB F.WriteReptLine
EndInput:

        Temp% = INSTR(R$, "VAL(")
          IF Temp% <> 0 THEN
             NOFLTIN& = False%:  Conflict$ = "  NOFLTIN  "
             GOSUB F.WriteReptLine
          END IF
        Temp% = INSTR(R$, "READ ")
          IF Temp% <> 0 THEN
             NOFLTIN& = False%:  Conflict$ = "  NOFLTIN  "
             GOSUB F.WriteReptLine
          END IF

        Temp% = INSTR(R$, "LPT1: ")
        Temp2% = INSTR(R$, "LPRINT")
          IF (Temp% <> 0) OR (Temp2% <> 0) THEN
             NOLPT& = False%:  Conflict$ = "  NOLPT    "
             GOSUB F.WriteReptLine
          END IF

        Temp% = INSTR(R$, "COM1:")
        Temp2& = INSTR(R$, "COM2:")
          IF (Temp% <> 0) OR (Temp2& <> 0) THEN
             NOCOM& = False%:  Conflict$ = "  NOCOM    "
             GOSUB F.WriteReptLine
          END IF


NextRecord:
  WEND

  PRINT
  PRINT STRING$(50, 196)
  PRINT "BASIC source file lines in.....: "; ICOUNT&
  PRINT "Conflict report is in file.....:  STUBSCAN.RPT"

  PRINT STRING$(50, 196)

  IF NOFLTIN& THEN PRINT "NOFLTIN   can be used."
  IF NOEDIT& THEN PRINT "NOEDIT    can be used."
  IF NOCOM& THEN PRINT "NOCOM     can be used."
  IF NOLPT& THEN PRINT "NOLPT     can be used."
  IF SMALLERR& THEN PRINT "SMALLERR  can be used."
  PRINT STRING$(50, 196)

  Stub$ = ""
  IF NOFLTIN& THEN Stub$ = Stub$ + "+NOFLTIN"
  IF NOEDIT& THEN Stub$ = Stub$ + "+NOEDIT"
  IF NOCOM& THEN Stub$ = Stub$ + "+NOCOM"
  IF NOLPT& THEN Stub$ = Stub$ + "+NOLPT"
  IF SMALLERR& THEN Stub$ = Stub$ + "+SMALLERR"
  IF Stub$ = "" THEN GOTO EndStubBat  ' No bat file since no stubs

 ' Get the bare file name to build the .OBJ filename in STUB.BAT...
  IFILE$ = UCASE$(IFILE$)
  Temp% = INSTR(IFILE$, ".")
  IF Temp% <> 0 THEN
     IFILE$ = LEFT$(IFILE$, (Temp% - 1))  ' Trim any filetype
  END IF
  TLEN% = LEN(IFILE$)
  Chop% = 0
  FOR Temp% = 1 TO TLEN%  ' Look for rightmost "\" or ":" to chop leading
      C$ = MID$(IFILE$, Temp%, 1)
      IF (C$ = "\") OR (C$ = ":") THEN Chop% = Temp%
  NEXT Temp%
  IF Chop% <> 0 THEN IFILE$ = RIGHT$(IFILE$, (TLEN% - Chop%))
 '-----------------------------------------------------------

  CLOSE 1: OPEN "STUB.BAT" FOR OUTPUT AS #1
  PRINT #1, "  @Echo OFF"
  PRINT #1, "  Rem STUB.BAT for "; IFILE$; ".OBJ screened by STUBSCAN.EXE"
  PRINT #1, "  LINK /NOE "; IFILE$; ".OBJ";
  PRINT #1, Stub$; ";"
  CLOSE 1
  PRINT "STUB.BAT will link stubs with "; IFILE$; ".OBJ."
EndStubBat:
  PRINT STRING$(50, 196)
  PRINT "NOTE:"
  PRINT "Review STUBSCAN.RPT report file.  It may"
  PRINT "be possible to use additional stub files."
  PRINT STRING$(50, 196)
 '
  GOTO PgmExit
 '------------

F.WriteReptLine:
300 PRINT #2, USING "####"; ICOUNT&;
    PRINT #2, Conflict$; "  "; R$
301 RETURN
   '------

E.Handler:
  IF ERL = 100 THEN
     PRINT IFILE$; " not found or error OPENing it.  Halting."
     GOTO PgmExit
  END IF
  IF (ERL = 200) OR (ERL = 300) THEN
     PRINT "Error handling STUBSCAN.RPT output file.  Halting."
     GOTO PgmExit
  END IF
  PRINT "Untrapped error "; ERR; " in STUBSCAN.EXE.  Sorry."
PgmExit:
  CLOSE
  SYSTEM
 '------